if (!requireNamespace("groundhog", quietly = TRUE)) {
install.packages("groundhog")
library("groundhog")
}
pkgs <- c("magrittr", "data.table", "stringr", "lubridate", "knitr", "glue",
"sandwich", "lmtest",
"ggplot2", "ggpubr", "rstatix", "patchwork", "scales")
groundhog::groundhog.library(pkg = pkgs,
date = "2023-09-25")Online Appendix C
Ambiguity attitudes and surprises
This document explains how to reproduce the figures presented in the paper.
Install Packages
We install the following packages using the groundhog package manager to increase computational reproducibility.
Read Data
# data <- data.table::fread(file = "../data/processed/full.csv")
data <- readRDS(file="../data/processed/full.Rda")data[, communication := as.factor(communication)]
data[, communication := factor(communication, levels = c("point", "both","interval"))]
data[, stage := as.factor(stage)]
data[, stage := factor(stage, levels = c("1", "2"))]Data set
ful1<-subset(data,data$stage==1)
ful2<-subset(data,data$stage==2)
cols <- c("participant.label", "E1", "E2", "E3", "E12","E23","E13","b","a","communication","surprise")
ful1 <- ful1[, ..cols]
ful2 <- ful2[, ..cols]
fgr<-merge(ful1,ful2,by=c("participant.label","communication","surprise"))
ful1<-NULL
ful2<-NULL#Subsets for the figures table
fgr1<-subset(fgr,fgr$surprise==TRUE & fgr$communication=="both")
fgr2<-subset(fgr,fgr$surprise==TRUE & fgr$communication=="interval")
fgr3<-subset(fgr,fgr$surprise==TRUE & fgr$communication=="point")
fgr4<-subset(fgr,fgr$surprise==FALSE & fgr$communication=="both")
fgr5<-subset(fgr,fgr$surprise==FALSE & fgr$communication=="interval")
fgr6<-subset(fgr,fgr$surprise==FALSE & fgr$communication=="point")
fgr7<-subset(fgr,fgr$surprise==TRUE)
fgr8<-subset(fgr,fgr$surprise==FALSE)Figure OC1
To create Figure 1 (and the other figures), we create a wrapper function that we can call several times. As all the other figures presented in this document, Figure 1 consists of eight panels, that are relatively similar. We thus, save both space and sources of error by creating a wrapper function plot_bars() that creates bar plots and annotates them.
plot_bars <- function(outcome.y,outcome.x,participant.label,tmp, breaks, limits,x1,x2,x3,x4,y1,y2,y3,y4){
#percentage for graph:
p1<-scales::percent(as.numeric(table(outcome.y>outcome.x)["TRUE"]/length(unique(participant.label))),accuracy = 1)#upper percentage
p2<-scales::percent(as.numeric(table(outcome.y<outcome.x)["TRUE"]/length(unique(participant.label))),accuracy = 1)#lower percentage
#Spearman Correlation for Subtitle of graph:
ro.value<-round(cor(outcome.x, outcome.y, method = c("spearman")),2)
plot<-ggplot(data=tmp, aes(x = outcome.x, y = outcome.y)) +
geom_count(shape=1,show.legend = FALSE)+
theme(line = element_blank(), panel.background = element_rect(fill = "white",
colour = "white",
linewidth = 0.5, linetype = "solid"))+
xlab(as.expression(bquote(rho~"="~.(ro.value)))) +
ylab("") +
geom_vline(xintercept = 0, colour = "black")+
geom_hline(yintercept = 0, colour = "black")+
geom_abline(intercept = 0, slope = 1, color="black",
linewidth=0.6)+
scale_x_continuous(breaks = breaks, lim = limits)+
scale_y_continuous(breaks = breaks, lim = limits)+
geom_text(x=x1, y=y1, label="Part 1")+
geom_text(x=x2, y=y2, label="Part 2")+
geom_text(x=x3, y=y3, label=p1)+
geom_text(x=x4, y=y4, label=p2)
plot
}top1 <- plot_bars(fgr8$b.y,fgr8$b.x,fgr8$participant.label,fgr8,seq(-1, 1, 0.5), c(-1.02, 1.02),0.9,0.3,-0.6,0.6,-0.115,1.05,0.7,-0.7)
top2 <- plot_bars(fgr7$b.y,fgr7$b.x,fgr7$participant.label,fgr7, seq(-1, 1, 0.5), c(-1.02, 1.02),0.9,0.3,-0.6,0.6,-0.115,1.05,0.7,-0.7)
middle1 <- plot_bars(fgr6$b.y,fgr6$b.x,fgr6$participant.label,fgr6, seq(-1, 1, 0.5), c(-1.02, 1.02),0.9,0.3,-0.6,0.6,-0.115,1.05,0.7,-0.7)
middle2 <- plot_bars(fgr5$b.y,fgr5$b.x,fgr5$participant.label,fgr5, seq(-1, 1, 0.5), c(-1.02, 1.02),0.9,0.3,-0.6,0.6,-0.115,1.05,0.7,-0.7)
middle3 <- plot_bars(fgr4$b.y,fgr4$b.x,fgr4$participant.label,fgr4, seq(-1, 1, 0.5), c(-1.02, 1.02),0.9,0.3,-0.6,0.6,-0.115,1.05,0.7,-0.7)
down1 <- plot_bars(fgr3$b.y,fgr3$b.x,fgr3$participant.label,fgr3, seq(-1, 1, 0.5), c(-1.02, 1.02),0.9,0.3,-0.6,0.6,-0.115,1.05,0.7,-0.7)
down2 <- plot_bars(fgr2$b.y,fgr2$b.x,fgr2$participant.label,fgr2, seq(-1, 1, 0.5), c(-1.02, 1.02),0.9,0.3,-0.6,0.6,-0.115,1.05,0.7,-0.7)
down3 <- plot_bars(fgr1$b.y,fgr1$b.x,fgr1$participant.label,fgr1, seq(-1, 1, 0.5), c(-1.02, 1.02),0.9,0.3,-0.6,0.6,-0.115,1.05,0.7,-0.7)
( (top1|top2) / (middle1 | middle2 | middle3) / (down1 | down2 | down3) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")Figure OC.2
top1 <- plot_bars(fgr8$a.y,fgr8$a.x,fgr8$participant.label,fgr8, seq(-2, 4, 1), c(-2, 4), 3.4,0.8,-1.5,1.5,-0.4,3.9,1.9,-1.9)
top2 <- plot_bars(fgr7$a.y,fgr7$a.x,fgr7$participant.label,fgr7, seq(-2, 4, 1), c(-2, 4), 3.4,0.8,-1.5,1.5,-0.4,3.9,1.9,-1.9)
middle1 <- plot_bars(fgr6$a.y,fgr6$a.x,fgr6$participant.label,fgr6, seq(-2, 4, 1), c(-2, 4), 3.4,0.8,-1.5,1.5,-0.4,3.9,1.9,-1.9)
middle2 <- plot_bars(fgr5$a.y,fgr5$a.x,fgr5$participant.label,fgr5, seq(-2, 4, 1), c(-2, 4), 3.4,0.8,-1.5,1.5,-0.4,3.9,1.9,-1.9)
middle3 <- plot_bars(fgr4$a.y,fgr4$a.x,fgr4$participant.label,fgr4, seq(-2, 4, 1), c(-2, 4), 3.4,0.8,-1.5,1.5,-0.4,3.9,1.9,-1.9)
down1 <- plot_bars(fgr3$a.y,fgr3$a.x,fgr3$participant.label,fgr3, seq(-2, 4, 1), c(-2, 4), 3.4,0.8,-1.5,1.5,-0.4,3.9,1.9,-1.9)
down2 <- plot_bars(fgr2$a.y,fgr2$a.x,fgr2$participant.label,fgr2, seq(-2, 4, 1), c(-2, 4), 3.4,0.8,-1.5,1.5,-0.4,3.9,1.9,-1.9)
down3 <- plot_bars(fgr1$a.y,fgr1$a.x,fgr1$participant.label,fgr1, seq(-2, 4, 1), c(-2, 4), 3.4,0.8,-1.5,1.5,-0.4,3.9,1.9,-1.9)
( (top1|top2) / (middle1 | middle2 | middle3) / (down1 | down2 | down3) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")Figure OC.3
top1 <- plot_bars(fgr8$E1.y,fgr8$E1.x,fgr8$participant.label,fgr8, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
top2 <- plot_bars(fgr7$E1.y,fgr7$E1.x,fgr7$participant.label,fgr7, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle1 <- plot_bars(fgr6$E1.y,fgr6$E1.x,fgr6$participant.label,fgr6, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle2 <- plot_bars(fgr5$E1.y,fgr5$E1.x,fgr5$participant.label,fgr5, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle3 <- plot_bars(fgr4$E1.y,fgr4$E1.x,fgr4$participant.label,fgr4, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down1 <- plot_bars(fgr3$E1.y,fgr3$E1.x,fgr3$participant.label,fgr3, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down2 <- plot_bars(fgr2$E1.y,fgr2$E1.x,fgr2$participant.label,fgr2, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down3 <- plot_bars(fgr1$E1.y,fgr1$E1.x,fgr1$participant.label,fgr1, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
( (top1|top2) / (middle1 | middle2 | middle3) / (down1 | down2 | down3) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")Figure OC.4
top1 <- plot_bars(fgr8$E2.y,fgr8$E2.x,fgr8$participant.label,fgr8, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
top2 <- plot_bars(fgr7$E2.y,fgr7$E2.x,fgr7$participant.label,fgr7, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle1 <- plot_bars(fgr6$E2.y,fgr6$E2.x,fgr6$participant.label,fgr6, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle2 <- plot_bars(fgr5$E2.y,fgr5$E2.x,fgr5$participant.label,fgr5, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle3 <- plot_bars(fgr4$E2.y,fgr4$E2.x,fgr4$participant.label,fgr4, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down1 <- plot_bars(fgr3$E2.y,fgr3$E2.x,fgr3$participant.label,fgr3, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down2 <- plot_bars(fgr2$E2.y,fgr2$E2.x,fgr2$participant.label,fgr2, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down3 <- plot_bars(fgr1$E2.y,fgr1$E2.x,fgr1$participant.label,fgr1, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
( (top1|top2) / (middle1 | middle2 | middle3) / (down1 | down2 | down3) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")Figure OC.5
top1 <- plot_bars(fgr8$E3.y,fgr8$E3.x,fgr8$participant.label,fgr8, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
top2 <- plot_bars(fgr7$E3.y,fgr7$E3.x,fgr7$participant.label,fgr7, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle1 <- plot_bars(fgr6$E3.y,fgr6$E3.x,fgr6$participant.label,fgr6, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle2 <- plot_bars(fgr5$E3.y,fgr5$E3.x,fgr5$participant.label,fgr5, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle3 <- plot_bars(fgr4$E3.y,fgr4$E3.x,fgr4$participant.label,fgr4, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down1 <- plot_bars(fgr3$E3.y,fgr3$E3.x,fgr3$participant.label,fgr3, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down2 <- plot_bars(fgr2$E3.y,fgr2$E3.x,fgr2$participant.label,fgr2, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down3 <- plot_bars(fgr1$E3.y,fgr1$E3.x,fgr1$participant.label,fgr1, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
( (top1|top2) / (middle1 | middle2 | middle3) / (down1 | down2 | down3) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")Figure OC.6
top1 <- plot_bars(fgr8$E12.y,fgr8$E12.x,fgr8$participant.label,fgr8, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
top2 <- plot_bars(fgr7$E12.y,fgr7$E12.x,fgr7$participant.label,fgr7, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle1 <- plot_bars(fgr6$E12.y,fgr6$E12.x,fgr6$participant.label,fgr6, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle2 <- plot_bars(fgr5$E12.y,fgr5$E12.x,fgr5$participant.label,fgr5, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle3 <- plot_bars(fgr4$E12.y,fgr4$E12.x,fgr4$participant.label,fgr4, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down1 <- plot_bars(fgr3$E12.y,fgr3$E12.x,fgr3$participant.label,fgr3, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down2 <- plot_bars(fgr2$E12.y,fgr2$E12.x,fgr2$participant.label,fgr2, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down3 <- plot_bars(fgr1$E12.y,fgr1$E12.x,fgr1$participant.label,fgr1, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
( (top1|top2) / (middle1 | middle2 | middle3) / (down1 | down2 | down3) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")Figure OC.7
top1 <- plot_bars(fgr8$E13.y,fgr8$E13.x,fgr8$participant.label,fgr8, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
top2 <- plot_bars(fgr7$E13.y,fgr7$E13.x,fgr7$participant.label,fgr7, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle1 <- plot_bars(fgr6$E13.y,fgr6$E13.x,fgr6$participant.label,fgr6, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle2 <- plot_bars(fgr5$E13.y,fgr5$E13.x,fgr5$participant.label,fgr5, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle3 <- plot_bars(fgr4$E13.y,fgr4$E13.x,fgr4$participant.label,fgr4, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down1 <- plot_bars(fgr3$E13.y,fgr3$E13.x,fgr3$participant.label,fgr3, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down2 <- plot_bars(fgr2$E13.y,fgr2$E13.x,fgr2$participant.label,fgr2, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down3 <- plot_bars(fgr1$E13.y,fgr1$E13.x,fgr1$participant.label,fgr1, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
( (top1|top2) / (middle1 | middle2 | middle3) / (down1 | down2 | down3) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")Figure OC.8
top1 <- plot_bars(fgr8$E23.y,fgr8$E23.x,fgr8$participant.label,fgr8, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
top2 <- plot_bars(fgr7$E23.y,fgr7$E23.x,fgr7$participant.label,fgr7, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle1 <- plot_bars(fgr6$E23.y,fgr6$E23.x,fgr6$participant.label,fgr6, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle2 <- plot_bars(fgr5$E23.y,fgr5$E23.x,fgr5$participant.label,fgr5, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
middle3 <- plot_bars(fgr4$E23.y,fgr4$E23.x,fgr4$participant.label,fgr4, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down1 <- plot_bars(fgr3$E23.y,fgr3$E23.x,fgr3$participant.label,fgr3, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down2 <- plot_bars(fgr2$E23.y,fgr2$E23.x,fgr2$participant.label,fgr2, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
down3 <- plot_bars(fgr1$E23.y,fgr1$E23.x,fgr1$participant.label,fgr1, seq(0, 100, 50), c(0, 101), 90,15,15,90,5,100,80,20)
( (top1|top2) / (middle1 | middle2 | middle3) / (down1 | down2 | down3) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")